Pascal Super Library/Pascal Super Library (CW International)(1997).bin/EDIT_UTL/TRIVED09/TRIVED.PAS

Pascal/Delphi Source File | 1995-04-23 | 60KB | 2,964 lines

program trived;  {trivial editor}

{
Russell Schulz - [e-mail] (950423)

Copyright 1995 Russell Schulz

this code is not in the Public Domain

permission is granted to use these routines in any application regardless
of commercial status as long as the author of these routines assumes no
liability for any damages whatsoever for any reason.  have fun.
}

{create a .TPM file for tp4}

{$ifdef VER40}
{$T+}
{$endif}

uses dos,crt,genericf;

{

KNOWN SHORTCOMINGS (but don't let them scare you away)

unable to search regexp's
unable to search-and-replace, among many other : commands
takes minimal advantage of terminal capabilities (possible feature)
ansi/vt100 hardwired in for cursor movement, clear screen, clear to end of line
implements only trivial subset of vi
doesn't implement modifiers (eg. dw, y3+, c$)
doesn't handle arrow keys from console or terminal
doesn't handle tabs in files very well
doesn't handle long lines very well

uses some vi keystrokes
  possible feature :-)


CREDITS:

Bill Joy, for the (incredibly more powerful) vi editor

}

{$define debug}
{$undef debug}

{$define smallmemory}
{$undef smallmemory}

{   stack,minimum heap,maximum heap  }

{$ifdef smallmemory}
{$M 8192,10240,24000}
{$else}
{$M 8192,10240,655360}
{$endif}

const
  editorname='trived';
  editorversion='0.9';

  rotates='\|/-\|/-\|/-\|/-\|/-\|/-\|/-\|/-\|/-\|/-/|\-';

  minlpp=8;
  maxlpp=50;

  mincols=32;
  maxcols=132;

  yespreserve=true;
  nopreserve=false;

{needed for serio}

  eightbitclean=true;
  readlnecho=true;


type
  ptr=^node;
  node=record
         str: string;
         next: ptr;
{$ifdef debug}
         seq: integer;
{$endif}
       end;

var
  lpp: integer;
  cols: integer;

  editinglpp: integer;

{$ifdef debug}
  debug: boolean;
  highseq: integer;
  history: string;
{$endif}

  shadow: integer;
  changed: boolean;

  head: ptr;
  afterhead: node;
  tail: ptr;
  unused: ptr;

  numlines: integer;
  port: integer;
  console: boolean;
  filename: string;
  thefile: text;
  quitout: boolean;
  topline: integer;
  currline: integer;
  currptr: ptr;
  currcol: integer;
  counter: integer;
  bufferedstring: string;
  keeptocol: integer;

  alwayshelp: boolean;

  directory: string;
  trusted: boolean;

  oldtextattr: byte;

  cmdline: string;
  searchstring: string;

  alternatefilename: string;

  undoline: integer;
  undostring: string;
  undomaybestring: string;

{below here are for serio}

  minutestorun: integer;
  idleminutes: integer;
  minstart: integer;
  minlastinput: integer;
  didtimeout: boolean;

  lowcolor: byte;
  highcolor: byte;

{$define pgdnbecomesgt}
{$define timeout}

{$I serio.pas}

procedure refreshall; forward;

procedure usage;

begin
  writeln('usage: ',editorname,' [options] filename');
  writeln;
  writeln('options:');
  writeln('  -h/--help for permanent on-screen help');
  writeln('  -m/--minutes number-of-minutes-to-run');
  writeln('  -d/--dir directory from where user may read files');
  writeln('  -p/--port 1 for COM1, 2 for COM2');
  writeln('  -f/--fossil-port 0 for COM1, 1 for COM2');
  writeln('  -t/--trusted modem user may read all files');
  writeln('  -l/--lines number-of-lines');
  writeln('  -c/--columns number-of-columns');
  writeln('  --colors low-color,high-color (e.g., 3,15)');
  writeln;
  writeln('  -f and -p are exactly the same except for');
  writeln('    -f starting at 0 and -p starting at 1');
  writeln;
  writeln('eg: (from waffle) ',editorname,' -p %d -m %O filename');
  writeln;
{$ifdef debug}
  writeln('debug: use ^A to turn on debugging info, ^Q to quit+dump');
  writeln;
{$endif}
  writeln('[e-mail] (930228)');
  halt(1);
end;

procedure restorecolors;

begin
  if console then
    begin
      xgotoxy(1,lpp);
      textattr := oldtextattr;
      writeln;  {so it uses these new (original) colors for sure}
    end;
end;

{$ifdef debug}
procedure restorecurs; forward;

procedure debugmsg(s: string);

begin
  if debug then
    begin
      gotoxy(40, 4);write(' -------------------------------- ');
      gotoxy(40, 5);write('|                                |');
      gotoxy(40, 6);write(' -------------------------------- ');
      gotoxy(42,5);
      write(s);
      restorecurs;
    end;
end;

procedure debugdie(s: string);

var
  aptr: ptr;
  linesprinted: integer;

begin
  restorecolors;

  if s<>'' then
    clrscr;

  writeln(s);
  writeln('history=',history);
  writeln;

  aptr := currptr;
  if aptr=nil then
    writeln('currptr=nil')
  else if aptr^.seq>highseq then
    writeln('currptr is invalid (sequence=',aptr^.seq,')')
  else
    writeln('currptr=',aptr^.seq:3,' ',copy(aptr^.str,1,40));
  writeln;

  linesprinted := 0;
  aptr := afterhead.next;
  while aptr<>nil do
    begin
      write('/',aptr^.seq:3,' ',copy(aptr^.str,1,10):10,' ');
      aptr := aptr^.next;
      inc(linesprinted);
      if linesprinted>numlines then
        begin
          writeln;
          writeln('saw ',linesprinted,' lines already -- too many');
          aptr := nil;
        end;
    end;

  halt(1);
end;
{$endif}


{ --- misc routines --- }


procedure donothing;

begin
end;

function mayuse(var somefn: string): boolean;

var
  problem: boolean;

begin
  problem := true;

  if trusted then
    problem := illegalfn(somefn)
  else
    begin
      problem := suspiciousfn(somefn);
      if not problem then
        somefn := directory+'\'+somefn;
    end;

  mayuse := not problem;
end;

function fixfn(fn: string): string;

begin
  if (fn='#') and (alternatefilename<>'') then
    fixfn := alternatefilename
  else
    fixfn := fn;
end;


{ --- undo --- }


procedure itmightchange;

begin
  undomaybestring := currptr^.str;
end;

procedure ithaschanged;

begin
  undoline := currline;
  undostring := undomaybestring;
  changed := true;
end;


{ --- linked list stuff --- }


function ptrafter(prevptr: ptr): ptr;

var
  result: ptr;

begin
  result := nil;
  if unused<>nil then
    begin

{$ifdef debug}
      debugmsg('got new ptr from unused');
{$endif}

      result := unused;
      unused := result^.next;
    end
  else if maxavail>1024 then
    begin

{$ifdef debug}
      debugmsg('got new ptr from heap');
{$endif}

      new(result);
    end;

  if result<>nil then
    begin
      result^.str := '';
      result^.next := nil;
{$ifdef debug}
      inc(highseq);
      result^.seq := highseq;
{$endif}

      if afterhead.next=nil then
        begin

{$ifdef debug}
          debugmsg('result is only node');
{$endif}

          afterhead.next := result;
          tail := result;
        end
      else
        begin

{$ifdef debug}
          if debug then
            if prevptr=nil then
              debugmsg('error: ptrafter(nil)');
{$endif}

          if prevptr=tail then
            begin

{$ifdef debug}
              debugmsg('result is new tail');
{$endif}

              tail := result;
            end;

          result^.next := prevptr^.next;
          prevptr^.next := result;
        end;
    end;

  ptrafter := result;
end;

function prev(aptr: ptr): ptr;

var
  result: ptr;
  chase: ptr;

begin
  result := nil;

  chase := head;
  while chase<>nil do
    begin
      if chase^.next=aptr then
        begin
          result := chase;
          chase := nil;
        end
      else
        chase := chase^.next;
    end;

{$ifdef debug}
  if debug then
    if result=nil then
      debugdie('error: prev('+aptr^.str+')=nil');
{$endif}

  prev := result;
end;

procedure deleteptr(aptr: ptr);

var
  prevptr: ptr;

begin
  prevptr := prev(aptr);

{fix up tail if need be}

  if aptr=tail then
    tail := prevptr;

{fix up main list}

  prevptr^.next := aptr^.next;

{add it to unused list}

  aptr^.next := unused;
  unused := aptr;
end;

function nthptr(n: integer): ptr;

var
  result: ptr;
  i: integer;
  steps: integer;

begin
  result := nil;

  if n=numlines then
    begin
      steps := 0;
      result := tail;
    end
  else if n>=currline then
    begin
      steps := n-currline;
      result := currptr;
    end
  else
    begin
      steps := n-1;
      result := afterhead.next;
    end;

  for i := 1 to steps do
    if result<>nil then
      result := result^.next;

  nthptr := result;
end;

procedure setcurrlineptr(lineno: integer);

begin
  currptr := nthptr(lineno);
  currline := lineno;
end;


{ --- i/o stuff --- }


procedure wastekey;

var
  wastec: char;

begin
  wastec := xreadkey;
end;

procedure warn(warning: string);

begin
  xgotoxy(1,lpp-1);
  xclreol;
  xgotoxy(1,lpp);
  xclreol;
  xwritess(warning,' - press any key ');
  wastekey;
  refreshall;
end;

function currlength: integer;

begin
  if currptr=nil then
    currlength := 0
  else
    currlength := length(currptr^.str);
end;

procedure reposcurs;

begin
  xgotoxy(currcol,currline-topline+1);
end;

procedure restorecurs;

begin
  currcol := min(currlength,keeptocol);

{}{} {need to scroll, not just restrict, but this allows the file to be edited}
  if currcol>cols then
    currcol := cols;

  if currcol=0 then
    currcol := 1;

  reposcurs;
end;

procedure setstatusline(s: string);

begin
  xclreolxy(1,lpp);
  xwritehighlights(s);
  restorecurs;
end;

procedure displayfileinfo;

var
  statusline: string;
  perthrough: integer;

begin
  statusline := '<'+filename+'>';

  if changed then
    statusline := statusline+' [modified]';

  statusline := statusline+'  line: '+itoa(currline)+' of '+itoa(numlines);

{handle short-integer math}

  if numlines>600 then
    perthrough := (10*currline) div (numlines div 10)
  else if numlines>300 then
    perthrough := (20*currline) div (numlines div 5)
  else
    perthrough := (100*currline) div numlines;

  if perthrough>100 then
    perthrough := 100;   {handle roundoffs more gracefully!}

  statusline := statusline+' -- <'+itoa(perthrough)+'>% --';

  if length(statusline)<cols-15 then
    statusline := statusline+'  Memory: <'+ltoa(maxavail div 1024)+'k>';

  setstatusline(statusline);
end;


{ --- cursor positioning --- }


procedure setcurrkeepcol(column: integer);

begin
  currcol := column;
  keeptocol := column;
end;


{ --- file routines --- }


procedure readfileinit;

begin
  afterhead.next := nil;
  tail := nil;
end;

procedure readfilefixups;

begin
  topline := 1;
  currline := 1;
  currptr := afterhead.next;
  setcurrkeepcol(1);
  counter := 0;
end;

procedure returnmemorytopool;

begin
{return all this memory to the unused pile}
  tail^.next := unused;
  unused := afterhead.next;

  readfileinit;
end;

procedure readfile;

var
  done: boolean;
  newptr: ptr;
  toolongline: boolean;
  rotatepos: integer;

begin
  numlines := 0;
  toolongline := false;

  done := false;

  assign(thefile,filename);
  {$I-}
  reset(thefile);
  {$I+}

  if ioresult<>0 then
    begin
      xwriteln;
      xwritelns('warning: unable to open file -- starting');
      xwrites('         with empty buffer: press any key ');
      wastekey;
    end
  else
    begin
      rotatepos := 1;
      while not eof(thefile) and not done do
        begin
          if numlines mod 16=0 then
            begin
              rotatepos := (rotatepos mod length(rotates))+1;
              xwritess(copy(rotates,rotatepos,1),chr(8));
            end;

          newptr := ptrafter(tail);
          if newptr=nil then
            done := true
          else
            begin
              inc(numlines);
              read(thefile,newptr^.str);

              if eoln(thefile) then
                readln(thefile)
              else
                toolongline := true;

{$ifdef debug}
              if debug then
                begin
                  writeln('read in: ',newptr^.str);
                  if newptr^.next<>nil then
                    debugdie('nil error: '+newptr^.next^.str);
                  if prev(newptr)^.next<>newptr then
                    debugdie('prev/next error');
                end;
{$endif}

            end;
        end;

      if not eof(thefile) then
        begin

      xwriteln;
      xwritelns('warning: unable to read in complete file - operations');
      xwrites('         which would add lines will not work: press any key ');

          wastekey;
          changed := true;
        end;

      if toolongline then
        begin

      xwriteln;
      xwrites('warning: some lines have been split:  press any key');

          wastekey;
          changed := true;
        end;

      close(thefile);
    end;

{0-length file -- can't handle it -- there's always at least one line}

  if afterhead.next=nil then
    begin
      newptr := ptrafter(tail);
      if newptr=nil then
        begin
          xwriteln;
          xwritelns('actually, there seems to be no memory at all');
          xwrites('   -- quitting now -- press any key ');
          wastekey;
          restorecolors;
          halt(1);
        end
      else
        begin
          newptr^.str := '';
          numlines := 1;
        end;
    end;

  changed := false;

  readfilefixups;

  refreshall;

  displayfileinfo;
end;

procedure writefile(fn: string);

var
  aptr: ptr;
  written: boolean;

begin
  setstatusline('writing...');

  written := true;

{should write to a temporary filename first!}

  assign(thefile,fn);
  {$I+}
  rewrite(thefile);
  {$I-}
  if ioresult<>0 then
    begin
      xwritelnsss(editorname,': could not write file ',fn);
      written := false;
    end
  else
    begin
      aptr := afterhead.next;
      while aptr<>nil do
        begin

{took out trimming of lines - broke signature delimeter!}
{no longer needed now that we don't have the stupid array anymore!}

{$I-}
          writeln(thefile,aptr^.str);
{$I+}
          aptr := aptr^.next;

          if ioresult<>0 then
            begin
              warn('could not write file!  (out of space?)');
              written := false;
              aptr := nil;
            end;
        end;

      close(thefile);

      if written then
        changed := false;
    end;

  displayfileinfo;
end;

procedure maybewritefile(fn: string);

begin
  if changed then
    writefile(fn);
end;

procedure rereadfile;

begin
  setstatusline('');

  returnmemorytopool;

  readfile;

  readfilefixups;

  refreshall;

  displayfileinfo;
end;

procedure mayberereadfile;

var
  y: char;
  c: char;

begin
  setstatusline('');
  xwritexy(1,lpp,'reread file: ');

  if changed then
    begin
      xwrites('FILE HAS CHANGED!  ');
      y := 'Y';
    end
  else
    begin
      xwrites('(file appears to not have changed) ');
      y := 'y';
    end;
  xwrites('reread anyway?  '+y+'=yes, n=no ');

  repeat
    c := xreadkey;
  until (c=y) or (c='n');

  if c='n' then
    setstatusline('')
  else
    rereadfile;
end;

procedure insertasciifile(fn: string);

var
  done: boolean;
  insertionptr: ptr;
  newptr: ptr;
  toolongline: boolean;
  rotatepos: integer;

begin
  done := false;

  toolongline := false;

  assign(thefile,fn);
{$I-}
  reset(thefile);
{$I+}
  if ioresult<>0 then
    setstatusline('could not read '+fn)
  else
    begin
      changed := true;

      insertionptr := currptr;
      newptr := currptr;
      done := false;

      while not eof(thefile) and not done do
        begin
          rotatepos := 1;

          if numlines mod 16=0 then
            begin
              rotatepos := (rotatepos mod length(rotates))+1;
              xwritess(copy(rotates,rotatepos,1),chr(8));
            end;

          newptr := ptrafter(insertionptr);
          if newptr=nil then
            done := true
          else
            begin
              inc(numlines);
              read(thefile,newptr^.str);
              insertionptr := newptr;

              if eoln(thefile) then
                readln(thefile)
              else
                toolongline := true;

{$ifdef debug}
              if debug then
                begin
                  writeln('read in: ',newptr^.str);
                  if newptr^.next<>nil then
                    debugdie('nil error: '+newptr^.next^.str);
                  if prev(newptr)^.next<>newptr then
                    debugdie('prev/next error');
                end;
{$endif}

            end;
        end;

      if not eof(thefile) then
        begin

      xwriteln;
      xwritelns('warning: unable to read in complete file - operations');
      xwrites('         which would add lines will not work: press any key ');

          wastekey;
        end;

      close(thefile);

      refreshall;
      displayfileinfo;
    end;
end;

procedure insertbinaryfile(fn: string);

const
  buffersize=384;

var
  failed: boolean;
  insertionptr: ptr;
  newptr: ptr;
  rotatepos: integer;
  binaryfile: file;
  buf: array[1..buffersize] of byte;
  numread: word;
  uupos: integer;
  uuline: string;
  uulen: integer;

  procedure addline(astring: string);

  begin
    if numlines mod 16=0 then
      begin
        rotatepos := (rotatepos mod length(rotates))+1;
        xwritess(copy(rotates,rotatepos,1),chr(8));
      end;

    newptr := ptrafter(insertionptr);
    if newptr=nil then
      failed := true
    else
      begin
        inc(numlines);
        newptr^.str := astring;
        insertionptr := newptr;
      end;
  end;

  function uuchar(b: byte): char;

  begin
    if b=0 then
      uuchar := '`'
    else
      uuchar := chr(b+32);
  end;

  procedure uue(l: integer; s: string);

  begin
    addline(uuchar(l)+s);
  end;

  procedure adduuch(n: integer; var l: integer; var s: string; b1,b2,b3: byte);

  begin
    if length(s)>=60 then
      begin
        uue(l,s);
        l := 0;
        s := '';
      end;

    s := s+uuchar(  (b1 and $fc) shr 2  );

    s := s+uuchar( ((b1 and $03) shl 4) or ((b2 and $f0) shr 4) );

    if n>1 then
      s := s+uuchar( ((b2 and $0f) shl 2) or ((b3 and $c0) shr 6) );

    if n>2 then
      s := s+uuchar(  (b3 and $3f)        );

    inc(l,n);
  end;

begin {insertbinaryfile}
  failed := false;

  rotatepos := 1;

  assign(binaryfile,fn);
{$I-}
  reset(binaryfile,1);
{$I+}
  if ioresult<>0 then
    setstatusline('could not read '+fn)
  else
    begin
      changed := true;

      insertionptr := currptr;
      newptr := currptr;

      addline('');
      if not failed then
        addline('begin 600 '+fn);

      uuline := '';
      uulen := 0;

      repeat
        blockread(binaryfile,buf,buffersize,numread);
        uupos := 1;
        while uupos<=numread do
          begin
            if uupos=numread then
              adduuch(1,uulen,uuline,buf[uupos],0,0)
            else if uupos=numread-1 then
              adduuch(2,uulen,uuline,buf[uupos],buf[uupos+1],0)
            else
              adduuch(3,uulen,uuline,buf[uupos],buf[uupos+1],buf[uupos+2]);
            inc(uupos,3);
          end;
      until (numread<buffersize) or failed;

      if (uuline<>'') and not failed then
        uue(uulen,uuline);

      if not failed then
        uue(0,'');

      if not failed then
        addline('end');

      if not failed then
        addline('');

      if failed then
        begin

      xwriteln;
      xwritelns('warning: unable to read in complete file - operations');
      xwrites('         which would add lines will not work: press any key ');

          wastekey;
        end;

      close(binaryfile);

      refreshall;
      displayfileinfo;
    end;
end;

procedure insertfile(fn: string);

begin
  if not fexists(fn) then
    setstatusline('<'+fn+'> does not exist')
  else
    begin
      if isasciifile(fn) then
        insertasciifile(fn)
      else
        insertbinaryfile(fn);
    end;
end;

procedure writetofile(fn: string);

begin
  writefile(fn);
end;

procedure maybewritetofile(fn: string);

begin
  if not fexists(fn) then
    writetofile(fn)
  else
    setstatusline('<'+fn+'> exists -- use :w! to force');
end;

procedure newfile(fn: string);

begin
  returnmemorytopool;

  alternatefilename := filename;
  filename := fn;

  readfile;

  readfilefixups;

  refreshall;

  displayfileinfo;
end;

procedure maybenewfile(fn: string);

begin
  if not changed then
    newfile(fn)
  else
    setstatusline('file has changed -- use :e! to force');
end;


{ --- counter stuff --- }


procedure addtocounter(i: integer);

begin

{cutoff is really 3276 or so}

  if counter<3000 then
    counter := counter*10+i;
end;

function usecounterdefault(defaultvalue: integer): integer;

var
  result: integer;

begin
  result := counter;
  if result=0 then
    result := defaultvalue;

  counter := 0;

  usecounterdefault := result;
end;

function usecounter: integer;

begin
  usecounter := usecounterdefault(1);
end;


{ --- editing stuff --- }


function isnewlineafter(aptr: ptr): boolean;

var
  result: boolean;
  wasteptr: ptr;

begin
  wasteptr := ptrafter(aptr);
  result := (wasteptr<>nil);

  if result then
    inc(numlines)
  else
    warn('not enough memory to add another line');

  isnewlineafter := result;
end;

procedure deletelineafter(aptr: ptr);

begin
  if numlines<2 then
    begin
      currptr^.str := '';
      numlines := 1;
    end
  else
    begin
      deleteptr(aptr^.next);
      dec(numlines);
    end;
end;

procedure delcharat(var s: string; col: integer);

begin
  if col<=length(s) then
    begin
      if col=1 then
        s := copy(s,2,255)
      else if col=length(s) then
        s := copy(s,1,col-1)
      else
        s := copy(s,1,col-1)+copy(s,col+1,255);
    end;
end;

function botline: integer;

begin
  botline := topline+editinglpp-1;
end;

function offscreen(lineno: integer): boolean;

begin
  offscreen := (lineno>botline) or (lineno<topline);
end;

procedure refreshaptr(aptr: ptr; lineat: integer);

begin

{$ifdef debug}
  if debug then
    if aptr=nil then
      debugdie('refreshaptr(nil)!');
{$endif}

  xclreolxy(1,lineat);

{it can edit long lines -- kind of -- as long as they're not displayed}

  if aptr<>nil then
    xwrites(copy(aptr^.str,1,cols-1));

{$ifdef debug}
  if debug then
    if cols>20 then
      begin
        xgotoxy(cols-10,lineat);
        xwrites(': ');
        xwritei(aptr^.seq);
        xwrites(' :');
      end;
{$endif}

end;

procedure refreshaline(lineat: integer);

var
  refreshptr: ptr;

begin
  refreshptr := nthptr(topline+lineat-1);

{$ifdef debug}
  if debug then
    if refreshptr=nil then
      begin
        writeln;
        writeln('nthptr(',topline+lineat-1,')=nil!');
        debugdie('');
      end;
{$endif}

  if refreshptr<>nil then
    refreshaptr(refreshptr,lineat);
end;

procedure refreshline;

begin
  refreshaline(currline-topline+1);
  reposcurs;
end;

procedure refreshpart(top, bottom: integer);

var
  i: integer;
  refreshptr: ptr;

begin
  refreshptr := nthptr(topline+top-1);

{$ifdef debug}
  if debug then
    if refreshptr=nil then
      begin
        writeln;
        writeln('nthptr(topline+top-1=',topline,'+',top,'-1)=nil!');
        debugdie('');
      end;
{$endif}

  for i := top to bottom do
    if refreshptr<>nil then
      begin
        refreshaptr(refreshptr,i);
        refreshptr := refreshptr^.next;
      end;

  restorecurs;
end;

procedure showhelp;

begin
  xgotoxy(1,lpp-3);
  xwritehighlights(
   '<q>uit <w>rite to disk <j>=down <k>=up <h>=left <l>=right '+
   '<^F>=forward page <^B>=back page');

  xgotoxy(1,lpp-2);
  xwritehighlights(
   '<z>=bighelp <x>=del <i>nsert/<a>ppend (<Esc> when done) <^L>=refresh '+
   '<1G>=top <G>=bottom');

end;

procedure refreshall;

begin
  xclrscr;
  if alwayshelp then
    showhelp;

  refreshpart(1,editinglpp);
end;

procedure refreshcurrlineandbelow;

begin
  refreshpart(currline-topline+1,editinglpp);
end;

procedure currnextline;

begin
  if currptr^.next<>nil then
    begin
      currptr := currptr^.next;
      inc(currline);
    end;
end;

procedure currprevline;

var
  prevptr: ptr;

begin
  prevptr := prev(currptr);
  currptr := prevptr;
  dec(currline);
end;

procedure bighelp;

begin
  xclrscr;
  xgotoxy(1,1);
  xwritess('trivial editor: ',editorname);
  xwritess(' version ',editorversion);
  xwrites('   small memory, local+remote use');

  xgotoxy(1,2);
  xwrites('Russell Schulz   [e-mail] (950423)');

{
  xgotoxy(1,4);
  xwritehighlights(
   'vi cursor keys: <h>=left, <l>=right  <^F>=forward page  <1G> first line');
  xgotoxy(1,5);
  xwritehighlights(
   '                <j>=down, <k>=up     <^B>=back page     <G> last line');
}

  xgotoxy(1,4);
  xwritehighlights(
   'vi cursor keys:        <k>=up      <^F>=forward page  <1G> first line');
  xgotoxy(1,5);
  xwritehighlights(
   '                left=<h>  <l>=right  <^B>=back page     <G> last line');
  xgotoxy(1,6);
  xwritehighlights(
   '                      <j>=down');

  xgotoxy(1,8);
  xwritehighlights(
   '<x>=delete current character   <X>=delete left');
  xgotoxy(1,9);
  xwritehighlights(
   '<i>nsert characters at, <a>ppend characters after cursor');
  xgotoxy(1,10);
  xwritehighlights(
   '  <Esc> to exit');

  xgotoxy(1,12);
  xwritehighlights(
   '<s>plit line after cursor   <J>oin line with next');
  xgotoxy(1,13);
  xwritehighlights(
   '<o>pen a new line below current one (and insert)');
  xgotoxy(1,14);
  xwritehighlights(
   '<O>=open a new line above current one (and insert)');
  xgotoxy(1,15);
  xwritehighlights(
   '<D>elete current line  <Y>ank current line  <p>aste after');
  xgotoxy(1,16);
  xwritehighlights(
   '<^>=start of line  <$>=end                  <P>=paste before');
  xgotoxy(1,17);
  xwritehighlights(
   '<H>igh <M>id <L>ow line on screen     <~>=change capitalization');

  xgotoxy(1,19);
  xwritehighlights(
   '<^R>=reread file from disk (discarding all changes)');
  xgotoxy(1,20);
  xwritehighlights(
   '<^L>=refresh screen     <^G>=show file info');

  xgotoxy(1,23);
  xwritehighlights(
   '<w>rite and continue editing   <q>uit');

{$ifdef oldhelp}
  xwritexy(1,6 ,'vi cursor keys: h=left, l=right    ^f=forward page');
  xwritexy(1,7 ,'                j=down, k=up       ^b=back page');

  xwritexy(1,9 ,'x=delete current character   X=delete left');
  xwritexy(1,10,'i=insert characters at, a=append characters after cursor');
  xwritexy(1,11,'  Enter or Esc to exit  (restricted to one line right now)');

  xwritexy(1,13,'s=split line after cursor   J=join line with next');
  xwritexy(1,14,'o=open a new line below current one (and insert)');
  xwritexy(1,15,'O=open a new line above current one (and insert)');
  xwritexy(1,16,'D=delete current line  Y=yank current line  p=paste after');
  xwritexy(1,17,'^=start of line  $=end                      P=paste before');
  xwritexy(1,18,'1G=top of file G=bottom  H=high line on screen M=mid L=low');

  xwritexy(1,20,'^R=reread file from disk (discarding all changes)');
  xwritexy(1,21,'^L=refresh screen     ^G=show file info');

  xwritexy(1,23,'w=write and continue editing   q=quit');
{$endif}

  xwritexy(1,lpp,'press any key ');
  wastekey;

  refreshall;
end;

procedure help;

begin
  if alwayshelp then
    bighelp
  else
    setstatusline(
     '<z>=bighelp,<q>uit,<j>=down,<k>=up,<h>=left,<l>=right,'+
     '<x>=del,<i>ns,<^L>=refresh');
end;

procedure undo;

var
  undosavestring: string;

begin
  if undoline<>0 then
    begin
      if undoline<=numlines then
        begin
          setcurrlineptr(undoline);

{save it, to allow for hitting `u' twice in a row to redo}
          undosavestring := currptr^.str;
          currptr^.str := undostring;
          undostring := undosavestring;

          if offscreen(currline) then
            begin
              topline := max(1,undoline-2);
              refreshall;
            end
          else
            refreshline;
        end
      else
        begin
          warn('cannot undo this yet, sorry');
        end
    end;
end;

procedure downaline;

var
  needrefresh: boolean;
  countup: integer;

begin
  needrefresh := false;

  for countup := 1 to usecounter do
    begin
      if currptr^.next<>nil then
        begin
          currnextline;
          if offscreen(currline) then
            begin
              topline := min(topline+4,numlines);
              needrefresh := true;
            end;
        end;
    end;

  if needrefresh then
    refreshall;

  restorecurs;
end;

procedure upaline;

var
  needrefresh: boolean;
  countup: integer;

begin
  needrefresh := false;

  for countup := 1 to usecounter do
    begin
      if currptr<>afterhead.next then
        begin
          currprevline;
          if offscreen(currline) then
            begin
              topline := max(topline-4,1);
              needrefresh := true;
            end;
        end;
    end;

  if needrefresh then
    refreshall;
  restorecurs;
end;

procedure rightachar;

var
  countup: integer;

begin
  for countup := 1 to usecounter do
    if currcol<currlength then
      setcurrkeepcol(currcol+1);

  restorecurs;
end;

procedure leftachar;

var
  countup: integer;

begin
  for countup := 1 to usecounter do
    if currcol>1 then
      setcurrkeepcol(currcol-1);

  restorecurs;
end;

procedure delchar;

var
  needrefresh: boolean;
  countup: integer;

begin
  itmightchange;

  needrefresh := false;

  for countup := 1 to usecounter do
    if currcol<=currlength then
      begin
        ithaschanged;
        delcharat(currptr^.str,currcol);

{trivial screen optimization}

        if (currcol>currlength) and not needrefresh then
          begin
            xwrites(' ');
            restorecurs;
          end
        else
          needrefresh := true;

        if currcol>currlength then
          setcurrkeepcol(currlength);
      end;

  restorecurs;

  if needrefresh then
    refreshline;
end;

procedure delcharleft;

var
  needrefresh: boolean;
  countup: integer;

begin
  itmightchange;

  needrefresh := false;

  for countup := 1 to usecounter do
    if currcol>1 then
      begin
        ithaschanged;

        setcurrkeepcol(currcol-1);
        delcharat(currptr^.str,currcol);

        needrefresh := true;
      end;

  restorecurs;

  if needrefresh then
    refreshline;
end;

procedure insert;

var
  c: char;
  doneline: boolean;
  doneins: boolean;
  newptr: ptr;
  blanklinesinarow: integer;  {user tolerance}

begin
  itmightchange;

  if alwayshelp then
    setstatusline('use <Esc> to exit');

  blanklinesinarow := 0;

  doneins := false;
  while not doneins do
    begin
      doneline := false;
      while not doneline and not doneins do
        begin
          c := xreadkey;

          {delete backwards}
          if (c=#8) or (c=#127) then
            begin
              if (currcol>1) and (currcol<=currlength+1) then
                begin
                  ithaschanged;

{trivial screen optimization if this is last char on line - common case}

                  if currcol>currlength then
                    begin
                      setcurrkeepcol(currcol-1);
                      delcharat(currptr^.str,currcol);
                      reposcurs;
                      xwrites(' ');
                      reposcurs;
                    end
                  else
                    begin
                      setcurrkeepcol(currcol-1);
                      delcharat(currptr^.str,currcol);
                      refreshline;
                    end;
                end;
            end
          else if (c=#13) then
            begin
              doneline := true;
            end
          else if (c=#27) then
            begin
              doneins := true;
            end
          else if (ord(c)>=32) and (eightbitclean or (ord(c)<127)) then
            begin
              ithaschanged;

{trivial screen optimization if this is last character - very common case}

              if currcol>currlength then
                begin
                  currptr^.str := currptr^.str+c;
                  reposcurs;
                  xwrites(c);
                  setcurrkeepcol(currcol+1);
                end
              else
                begin
                  if currcol=1 then
                    currptr^.str := c+currptr^.str
                  else
                    currptr^.str :=
                     copy(currptr^.str,1,currcol-1)+c+
                     copy(currptr^.str,currcol,255);
                  setcurrkeepcol(currcol+1);
                  refreshline;
                end;
            end;

          if currlength>=250 then
            doneline := true;

        end;     {doneline}

    if not doneins then
      begin
        if currptr^.str='' then
          inc(blanklinesinarow)
        else
          blanklinesinarow := 0;

        newptr := ptrafter(currptr);
        if newptr=nil then
          begin
            doneins := true;
            warn('out of memory');
          end
        else
          begin
            inc(numlines);

            setcurrkeepcol(1);
            setcurrlineptr(currline+1);

            if offscreen(currline) then
              begin
                topline := min(topline+4,numlines);
                refreshall;
              end
            else
              refreshcurrlineandbelow;

            if alwayshelp then
              setstatusline('use <Esc> to exit')
            else if blanklinesinarow>3 then
              begin
                setstatusline('use <Esc> to exit');
                blanklinesinarow := 0;
              end;
          end
      end;

  end;    {doneins}

  setstatusline('');

{vi would do a cursorleft here}
  restorecurs;
end;

procedure append;

begin
  inc(currcol);
  reposcurs;
  insert;
end;

procedure replace;

var
  c: char;

begin
  itmightchange;

  if currcol<=currlength then
    begin
      c := xreadkey;
      if c<>#27 then
        begin
          ithaschanged;
          currptr^.str[currcol] := c;
          xwrites(c);
          restorecurs;
        end;
    end;
end;

procedure replacemuch;

var
  c: char;
  done: boolean;

begin
  itmightchange;

  done := false;

  while (currcol<=currlength) and not done do
    begin
      c := xreadkey;
      if c=#27 then
        done := true
      else
        begin
          ithaschanged;
          currptr^.str[currcol] := c;
          xwrites(c);
          setcurrkeepcol(currcol+1);
          keeptocol := currcol-1;
        end;
    end;
end;

procedure gotocol;

begin
  setcurrkeepcol(usecounter);
  restorecurs;
end;

procedure gofirstcol;

begin
  setcurrkeepcol(1);
  restorecurs;
end;

procedure gofirstnonblankcol;

var
  newcol: integer;
  i: integer;

begin
  if currlength<2 then
    newcol := 1
  else
    begin
      newcol := 0;
      for i := 1 to currlength do
        if newcol=0 then
          if (currptr^.str[i]<>' ') and (currptr^.str[i]<>tab) then
            newcol := i;
      if newcol=0 then
        newcol := 1;
    end;

  setcurrkeepcol(newcol);
  restorecurs;
end;

procedure golastcol;

begin
  setcurrkeepcol(currlength);
  keeptocol := maxint;

  restorecurs;
end;

procedure split;

var
  oldstr: string;

begin
  itmightchange;

  if isnewlineafter(currptr) then
    begin
      ithaschanged;
      oldstr := currptr^.str;
      currptr^.str := copy(oldstr,1,currcol-1);
      currptr^.next^.str := copy(oldstr,currcol,255);

{trivial screen optimization}

      refreshcurrlineandbelow;

      restorecurs;
    end;

  keeptocol := currcol;
end;

procedure combine;

begin
  itmightchange;

  if currptr^.next<>nil then
    if currlength+length(currptr^.next^.str)<254 then
      begin
        ithaschanged;

        golastcol;

        currptr^.str := currptr^.str+' '+currptr^.next^.str;
        deletelineafter(currptr);

{trivial screen optimization}

        refreshcurrlineandbelow;
      end;
end;

procedure openbelow;

begin
  itmightchange;

  keeptocol := 1;

  if isnewlineafter(currptr) then
    begin
      ithaschanged;
      currnextline;

{trivial screen optimization}

      if offscreen(currline) then
        begin
          inc(topline);
          refreshall;
        end
      else
        refreshcurrlineandbelow;

      insert;
    end;
end;

procedure openabove;

var
  aptr: ptr;
  prevptr: ptr;

begin
  itmightchange;

  prevptr := prev(currptr);
  if isnewlineafter(prevptr) then
    begin
      ithaschanged;

      setcurrlineptr(currline);

      refreshcurrlineandbelow;
      insert;
    end;

  keeptocol := 1;
end;

procedure pastebefore;

var
  aptr: ptr;
  prevptr: ptr;

begin
  itmightchange;

  prevptr := prev(currptr);
  if isnewlineafter(prevptr) then
    begin
      ithaschanged;

      setcurrlineptr(currline);

      currptr^.str := bufferedstring;

{trivial screen optimization}

      if offscreen(currline) then
        begin
          inc(topline);
          refreshall;
        end
      else
        refreshcurrlineandbelow;

    end;

  keeptocol := currcol;
end;

procedure pasteafter;

begin
  itmightchange;

  if isnewlineafter(currptr) then
    begin
      ithaschanged;

      currnextline;
      currptr^.str := bufferedstring;

{trivial screen optimization}

      if offscreen(currline) then
        begin
          inc(topline);
          refreshall;
        end
      else
        refreshcurrlineandbelow;
    end;

  keeptocol := currcol;
end;

procedure deleteline;

var
  prevptr: ptr;
  needrefresh: boolean;
  countup: integer;

begin
  itmightchange;

  needrefresh := false;

  for countup := 1 to usecounter do
    begin
      ithaschanged;

      bufferedstring := currptr^.str;

{don't leave that last line dangle if it's on the screen now -- it won't later}

      if not offscreen(numlines) then
        xclreolxy(1,numlines-topline+1);

      prevptr := prev(currptr);

      deletelineafter(prevptr);
      currptr := prevptr;

{currline can get out of sync here, but it's fixed up right away}
      if currptr^.next<>nil then
        currptr := currptr^.next;

{trivial screen optimization}

      if currline>numlines then
        begin
          dec(currline);
          if offscreen(currline) then
            begin
              dec(topline,3*(editinglpp div 4));
              if topline<1 then
                topline := 1;
              needrefresh := true;
            end;
          restorecurs;
        end
      else
        refreshcurrlineandbelow;

    end;

  if needrefresh then
    refreshall;

  keeptocol := currcol;
end;

procedure yankline;

begin
  bufferedstring := currptr^.str;
end;

procedure gotoline;

var
  newcurrline: integer;

begin
  newcurrline := min(usecounterdefault(numlines),numlines);

  if newcurrline=numlines then
    begin
      currline := numlines;
      currptr := tail;
    end
  else
    setcurrlineptr(newcurrline);

  if offscreen(currline) then
    begin
      topline := max(currline-editinglpp+2,1);
      refreshall;
    end;

  restorecurs;
end;

procedure goforwardpg;

begin
  if offscreen(numlines) then
    begin
      setcurrlineptr(min(numlines,currline+editinglpp-2));
      topline := min(numlines,topline+editinglpp-2);
      refreshall;
    end
  else
    begin
      setcurrlineptr(numlines);
    end;

  restorecurs;
end;

procedure gobackpg;

begin
  if not offscreen(1) then
    setcurrlineptr(1)
  else
    begin
      setcurrlineptr(max(1,currline-(editinglpp-2)));
      topline := max(1,topline-(editinglpp-2));
      refreshall;
    end;

  restorecurs;
end;

procedure scrollup;

var
  needrefresh: boolean;
  countup: integer;

begin
  needrefresh := false;

  for countup := 1 to usecounter do
    if topline>1 then
      begin
        needrefresh := true;
        dec(topline);
        if offscreen(currline) then
          setcurrlineptr(currline-1);
    end;

  if needrefresh then
    refreshall;
end;

procedure scrolldown;

var
  needrefresh: boolean;
  countup: integer;

begin
  needrefresh := false;

  for countup := 1 to usecounter do
    if topline<numlines then
      begin
        needrefresh := true;
        inc(topline);
        if offscreen(currline) then
          setcurrlineptr(currline+1);
    end;

  if needrefresh then
    refreshall;
end;

procedure gohighline;

begin
  setcurrlineptr(topline);
  restorecurs;
end;

procedure golowline;

begin
  setcurrlineptr(min(botline,numlines));
  restorecurs;
end;

procedure gomidline;

begin
  setcurrlineptr((topline+min(botline,numlines)) div 2);
  restorecurs;
end;

procedure changecase;

var
  c: char;

begin
  itmightchange;

  if currcol<=currlength then
    begin
      c := currptr^.str[currcol];
      if isalpha(c) then
        begin
          ithaschanged;
          if islower(c) then
            c := upcase(c)
          else
            c := lowcase(c);
          currptr^.str[currcol] := c;
          xwrites(c);
        end;

      if currcol<currlength then
        setcurrkeepcol(currcol+1);

      restorecurs;
    end;
end;

procedure quit;

var
  c: char;
  keylist: string;

begin
  setstatusline('');

  if changed then
    begin
      xwritexy(1,lpp,
       'quit: NOT SAVED!  save first? y=yes, N=no, e=edit some more ');
      keylist := 'yNe';
    end
  else
    begin
      xwritexy(1,lpp,'quit?  y=yes, n=no ');
      keylist := 'yn';
    end;

  repeat
    c := xreadkey;
  until pos(c,keylist)<>0;

  if changed then
    if c='y' then
      begin
        xwrites('yes: quit+save');
        writefile(filename);
        quitout := true;
      end
    else if c='e' then
      begin
        setstatusline('');
      end
    else
      begin
        xwrites('no: quit, NO save');
        quitout := true;
      end
  else
    if c='y' then
      begin
        xwrites('yes: quit (no changes)');
        quitout := true;
      end
    else
      begin
        setstatusline('');
      end
end;

procedure coloncommands;

var
  cmdverb: string;
  cmdobj: string;

begin
  setstatusline('<:>');

  xgotoxy(2,lpp);
  xreadlns(cmdline,cols-2,yespreserve);

  xgotoxy(1,lpp);

  cmdline := lower(trim(ltrim(cmdline)));

{first, assume no arguments}

  if cmdline='' then donothing

  else if cmdline='h' then bighelp
  else if cmdline='help' then bighelp

  else if cmdline='f' then displayfileinfo
  else if cmdline='file' then displayfileinfo

  else if cmdline='q' then quit
  else if cmdline='quit' then quit

  else if cmdline='q!' then quitout := true
  else if cmdline='quit!' then quitout := true

  else if cmdline='w' then writefile(filename)
  else if cmdline='write' then writefile(filename)

  else if cmdline='e' then mayberereadfile
  else if cmdline='edit' then mayberereadfile

  else if cmdline='e!' then rereadfile
  else if cmdline='edit!' then rereadfile

  else if cmdline='x' then
    begin
      maybewritefile(filename);
      quitout := true;
    end

  else if atoi(cmdline)>0 then
    begin
      counter := atoi(cmdline);
      gotoline;
    end

{after here are commands which take filename arguments}

  else {if cmdline<>'' then} {could put it here, but removes symmetry above}
    begin
      cmdobj := unslash(cmdline);
      cmdverb := chopfirstw(cmdobj);

      cmdobj := fixfn(cmdobj);

      if cmdobj='' then
        setstatusline('<Unknown command>')
      else if not trusted and (directory='') then
        setstatusline('<Would require --trusted or --directory>')
      else
        begin

{note that mayuse changes cmdobj to full directory/path if need be}

          if not mayuse(cmdobj) then
            begin
              if trusted then
                setstatusline('<illegal filename>')
              else
                setstatusline('<illegal filename without --trusted>')
            end
          else if (cmdverb='r') or (cmdverb='read') then
            insertfile(cmdobj)
          else if (cmdverb='w') or (cmdverb='write') then
            maybewritetofile(cmdobj)
          else if (cmdverb='w!') or (cmdverb='write!') then
            writetofile(cmdobj)
          else if (cmdverb='e') or (cmdverb='edit') then
            maybenewfile(cmdobj)
          else if (cmdverb='e!') or (cmdverb='edit!') then
            newfile(cmdobj)
          else
            setstatusline('<Unknown command>');
        end;
    end;

  restorecurs;
end;

procedure searchdirection(direction: integer);

var
  countup: integer;
  needrefresh: boolean;

  oldline: integer;
  newline: integer;

  newstr: string;
  newcol: integer;

  found: boolean;
  wrapped: boolean;

begin
{$ifdef debug}
  if (direction<>1) and (direction<>-1) then
    debugdie('direction='+itoa(direction));
{$endif}

  if searchstring='' then
    setstatusline('<No previous search string>')
  else
    begin
      needrefresh := false;

      setstatusline('/');

      found := false;
      wrapped := false;

      for countup := 1 to usecounter do
        begin
          if direction=1 then
            begin
              newstr := lower(copy(currptr^.str,currcol+1,255));
              newcol := pos(searchstring,newstr);
              if newcol<>0 then
                newcol := currcol+newcol;
            end
          else
            begin
              newstr :=
               lower(copy(currptr^.str,1,currcol-1+length(searchstring)-1));
              newcol := rpos(searchstring,newstr);
            end;

          if newcol<>0 then
            begin
              setcurrkeepcol(newcol);
              found := true;
            end
          else
            begin
              oldline := currline;
              found := false;

              repeat
                newline := currline+direction;
                if (newline<1) or (newline>numlines) then
                  begin
                    wrapped := true;
                    if newline<1 then
                      setcurrlineptr(numlines)
                    else
                      setcurrlineptr(1);
                  end
                else
                  setcurrlineptr(newline);

                if direction=1 then
                  newcol := pos(searchstring,lower(currptr^.str))
                else
                  newcol := rpos(searchstring,lower(currptr^.str));

                if newcol<>0 then
                  begin
                    found := true;
                    setcurrkeepcol(newcol);
                  end;
              until found or (oldline=currline);

              if offscreen(currline) then
                begin
                  if direction=1 then
                    topline := max(1,currline-2)
                  else
                    topline := min(numlines-editinglpp+1,currline+2);
                  needrefresh := true;
                end;
            end;
        end;

      restorecurs;

      if needrefresh then
        refreshall;

      if wrapped and found then
        setstatusline('(wrap)');

      if not found then
        setstatusline('<Pattern not found>');
    end;
end;

procedure searchnext;

begin
  searchdirection(1);
end;

procedure searchprevious;

begin
  searchdirection(-1);
end;

procedure slash;

begin
  setstatusline('</>');

  xgotoxy(2,lpp);
  xreadlns(searchstring,cols-2,yespreserve);

  searchstring := lower(searchstring);

  searchnext;
end;

procedure editfile;

var
  cmd: char;

begin
  bufferedstring := '';

  {no need for refresh here -- readfile already did it}

  undostring := '';
  undomaybestring := '';
  undoline := 0;

  alternatefilename := '';

  quitout := false;
  while not quitout do
    begin
      cmd := xreadkey;

{$ifdef debug}
      if length(history)>60 then
        history := copy(history,2,255)+cmd
      else
        history := history+cmd;

      if debug then
        begin
          gotoxy(40,10);write(' ---------------------- ');
          gotoxy(40,11);write('|                      |');
          gotoxy(40,12);write('|                      |');
          gotoxy(40,13);write('|                      |');
          gotoxy(40,14);write(' ---------------------- ');
          gotoxy(42,11);
          if (ord(cmd)<32) or (ord(cmd)>126) then
            writeln('got key# ',ord(cmd))
          else
            writeln('got key: ',cmd,' ',ord(cmd));
          gotoxy(42,12);
          writeln('old currline=',currline);
          gotoxy(42,13);
          writeln('old maxavail=',maxavail);
          restorecurs;
        end;
{$endif}

      case cmd of
        '?': help;

        'z': bighelp;

        'u': undo;

        'j': downaline;
        ^N : downaline;
        ^J : downaline;
        ^M : begin downaline; gofirstnonblankcol; end;
        '+': begin downaline; gofirstnonblankcol; end;

        'k': upaline;
        ^P : upaline;
        ^K : upaline;
        '-': begin upaline; gofirstnonblankcol; end;

        'l': rightachar;
        ' ': rightachar;
        ^U : rightachar;  { Apple ][ forever :-) }

        'h': leftachar;
        ^H : leftachar;
       #127: leftachar;

        ^L : refreshall;

        'x': delchar;
        'X': delcharleft;

        'i': insert;
        'I': begin gofirstcol; insert; end;  {vi has gofirstnonblank, alas}
        'a': append;
        'A': begin golastcol; append; end;

        's': split;
        'c': combine;
        'J': combine;

        'o': openbelow;
        'O': openabove;

        'p': pasteafter;
        'P': pastebefore;

        'D': deleteline;

        'Y': yankline;

        'G': gotoline;

        ^F : goforwardpg;
        '>': goforwardpg;
        ^B : gobackpg;
        '<': gobackpg;

        'H': gohighline;
        'M': gomidline;
        'L': golowline;

        'w': writefile(filename);
        ^R : mayberereadfile;

        ^G : displayfileinfo;

        ^E : scrollup;
        ^Y : scrolldown;

        'r': replace;
        'R': replacemuch;
        '~': changecase;

        ':': coloncommands;
        '/': slash;
        'n': searchnext;
        'N': searchprevious;

        '|': gotocol;
        '$': golastcol;
        '^': gofirstnonblankcol;

        '0': if counter=0 then gofirstcol else addtocounter(0);
        '1': addtocounter(1);
        '2': addtocounter(2);
        '3': addtocounter(3);
        '4': addtocounter(4);
        '5': addtocounter(5);
        '6': addtocounter(6);
        '7': addtocounter(7);
        '8': addtocounter(8);
        '9': addtocounter(9);

{$ifdef debug}
        ^A : debug := not debug;
        ^Q : if debug then debugdie('control-Q');

        '!':
          begin
            gotoxy(40,2);write(' -------------------------- ');
            gotoxy(40,3);write('|                          |');
            gotoxy(40,4);write('|                          |');
            gotoxy(40,5);write('|                          |');
            gotoxy(40,6);write('|                          |');
            gotoxy(40,7);write('|                          |');
            gotoxy(40,8);write('|                          |');
            gotoxy(40,9);write(' -------------------------- ');
            gotoxy(42,3);write('topline=',topline);
            gotoxy(42,4);write('currline=',currline);
            gotoxy(42,5);write('currcol=',currcol);
            gotoxy(42,6);write('length=',currlength);
            gotoxy(42,7);write('str=',copy(currptr^.str,1,20));
            gotoxy(42,8);write('seq=',currptr^.seq);
            restorecurs;
          end;
{$endif}

        'q': quit;
        'Q': quit;
      end;

{$ifdef debug}
      if debug then
        begin
          gotoxy(40,16);write(' ---------------------- ');
          gotoxy(40,17);write('|                      |');
          gotoxy(40,18);write('|                      |');
          gotoxy(40,19);write('|                      |');
          gotoxy(40,20);write(' ---------------------- ');
          gotoxy(42,17);
          if (ord(cmd)<32) or (ord(cmd)>126) then
            writeln('got key# ',ord(cmd))
          else
            writeln('got key: ',cmd,' ',ord(cmd));
          gotoxy(42,18);
          writeln('currline=',currline);
          gotoxy(42,19);
          writeln('maxavail=',maxavail);
          restorecurs;

          if quitout then
            gotoxy(1,lpp);
        end;
{$endif}

    end;
end;

procedure initialize;

var
  currparami: integer;
  currparams: string;

  colors: string;

  foundtrusted: boolean;

begin
  foundtrusted := false;

  shadow := 0;

{$ifdef debug}
  debug := false;
  highseq := 0;
  history := '';
{$endif}

{$ifdef debug}
  shadow := 1;
{$endif}

  alwayshelp := false;

  console := true;
  port := -1;
  minutestorun := maxint;
  idleminutes := 5;
  trusted := true;
  directory := '';

  oldtextattr := textattr;

  colors := getenv('COLORS');
  if colors='' then
    colors := getenv('COLOURS');
  if colors='' then
    colors := '7 15';

  lpp := 25;
  cols := 80;

  cmdline := '';
  searchstring := '';

  if paramcount=0 then
    usage;

{$ifdef debug}
  writeln('paramcount: ',paramcount);
  if paramcount>0 then writeln('paramstr(1): ',paramstr(1));
  if paramcount>1 then writeln('paramstr(2): ',paramstr(2));
  if paramcount>2 then writeln('paramstr(3): ',paramstr(3));
  if paramcount>3 then writeln('paramstr(4): ',paramstr(4));
  if paramcount>4 then writeln('paramstr(5): ',paramstr(5));
{$endif}

  currparami := 1;
  currparams := paramstr(currparami);
  while (currparami<=paramcount) and (copy(currparams,1,1)='-') do
    begin
      if currparams='-?' then
        usage
      else if (currparams='-h') or (currparams='--help') then
        begin
          alwayshelp := true;
        end
      else if (currparams='-m') or (currparams='--minutes') then
        begin
          if currparami=paramcount then
            usage;
          inc(currparami);
          currparams := paramstr(currparami);
          minutestorun := atoi(currparams);
        end
      else if (currparams='-d') or (currparams='--dir') then
        begin
          if currparami=paramcount then
            usage;
          inc(currparami);
          currparams := paramstr(currparami);
          directory := unslash(currparams);
          if right(directory,1)='\' then
            directory := copy(directory,1,length(directory)-1);
        end
      else if (currparams='-p') or (currparams='--port') then
        begin
          if currparami=paramcount then
            usage;
          inc(currparami);
          currparams := paramstr(currparami);
          port := atoi(currparams)-1;
          console := false;
          trusted := false;
        end
      else if (currparams='-f') or (currparams='--fossil-port') then
        begin
          if currparami=paramcount then
            usage;
          inc(currparami);
          currparams := paramstr(currparami);
          port := atoi(currparams);
          console := false;
          trusted := false;
        end
      else if (currparams='-t') or (currparams='--trusted') then
        begin
          foundtrusted := true;
        end
      else if (currparams='-l') or (currparams='--lines') then
        begin
          if currparami=paramcount then
            usage;
          inc(currparami);
          currparams := paramstr(currparami);
          lpp := atoi(currparams);
          lpp := max(minlpp,min(lpp,maxlpp));
        end
      else if (currparams='-c') or (currparams='--columns') then
        begin
          if currparami=paramcount then
            usage;
          inc(currparami);
          currparams := paramstr(currparami);
          cols := atoi(currparams);
          cols := max(mincols,min(cols,maxcols));
        end
      else if (currparams='--colors') or (currparams='--colours') then
        begin
          if currparami=paramcount then
            usage;
          inc(currparami);
          currparams := paramstr(currparami);
          colors := currparams;
        end
      else
        begin
          writeln('unknown parameter: ',currparams);
          usage;
        end;

      inc(currparami);
      if currparami<=paramcount then
        currparams := paramstr(currparami);
    end;

  if currparami<>paramcount then
    begin
      writeln('filename is required');
      usage;
    end;

  filename := paramstr(currparami);

  if not console then
    begin
      if (port<>0) and (port<>1) and (port<>2) and (port<>3) then
        begin
          writeln('must use port 1-4 (fossil-port 0-3)');
          usage;
        end;
    end;

  filename := unslash(filename);

  if foundtrusted then
    trusted := true;

  minstart := mitoday;
  minlastinput := mitoday;

  editinglpp := lpp-2;

  if alwayshelp then
    editinglpp := editinglpp-3;  {two lines of help, one blank line}

{with tpascal it's a pain to pass , on the command-line?!}
  colors := crepl(uncomma(ununderscore(colors)),'/',' ');
  if colors<>'' then
    begin
      lowcolor := atoi(chopfirstw(colors));
      highcolor := atoi(getfirstw(colors));
    end;

  if (lowcolor mod 16)=(highcolor mod 16) then
    if (lowcolor mod 16)=7 then
      highcolor := 15
    else
      lowcolor := 7;

  xlowvideo;

  head := @afterhead;
  unused := nil;

  readfileinit;
end;

begin
  initialize;

{$ifdef debug}
{$ifdef smallmemory}
  exec('c:\usr\bin\freem.exe','');
  xwritess(editorname,': freem: doserror=');
  xwritei(doserror);
  xwriteln;
{$endif}
{$endif}

  if fexists(filename) and not isasciifile(filename) then
    begin
      xwritelnss(editorname,' can only be used on ASCII files');
      usage;
    end;

  readfile;
  editfile;

  restorecolors;
end.